home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ASME's Mechanical Engine…ing Toolkit 1997 December
/
ASME's Mechanical Engineering Toolkit 1997 December.iso
/
ai
/
prlg195b.lzh
/
GAMES.LZH
/
KTOUR.PRO
< prev
next >
Wrap
Text File
|
1987-05-15
|
7KB
|
178 lines
/****************************************************************************/
/* */
/* THE KNIGHT'S TOUR */
/* */
/* by Tim Elliott */
/* */
/* */
/* Language: A.D.A. Prolog, ED version. (Also runs under PD). */
/* */
/* Requirements: Hardware must support graphics screen. */
/* */
/* Description: Solves the classic "knight's tour" puzzle. A knight is */
/* placed on a chessboard, and must visit each square once */
/* (that is, EXACTLY once), eventually visiting the entire */
/* board. */
/* */
/* Instructions: Once the A.D.A. Prolog interpreter is running, read */
/* in the program by typing "consult(ktour)." Then start */
/* the tour with "tour(size)." where size is a number */
/* from 1 to 9, 8 being the size of a standard chess board. */
/* This will start the knight in the upper left-hand corner */
/* of the board. To start the tour at some other square, */
/* type "tour(size,x,y)." where x and y are the coordinates */
/* of the desired starting point. */
/* */
/* Note: the program makes notes to itself in the database */
/* with the built-in "asserta" predicate. If it is */
/* interrupted abnormally, you may need to clean out */
/* these facts from the database. You can do this */
/* by typing "reset." before restarting the program. */
/* */
/* FOR MORE INFORMATION, READ THE ASSOCIATED KTOUR.DOC FILE */
/* */
/****************************************************************************/
tour(Size) :- tour(Size,1,1),!. /* "top level" goal, short form */
tour(Size,Xstart,Ystart) :- /* & long form */
crtgmode(Screen), /* save screen attributes */
board(Size), /* draw board */
claim(1,Xstart,Ystart), /* put knight on board */
proceed(2,Size), /* ******** tour ******** */
crtset(Screen), /* restore screen */
reset,!. /* clean up database */
proceed(Movenum,Size) :- /* one step toward a solution */
Tmoves is Size * Size,
Movenum =< Tmoves,
claimed(Xnow,Ynow),!,
moves(Xnow,Ynow,Size,L),
exelist(Movenum,L),
Nnum is Movenum + 1,
proceed(Nnum,Size).
proceed(_,_) :- /* recursion bottoms out here */
curset(23,1,0),
put(7),print('Tour complete. Find another? (Y/N)'),
get0(Key),
curset(23,1,0),
put(7),print(' '),
not (Key = 121; Key = 89). /* y or Y */
moves(X,Y,Size,L) :- /* L = sorted list of legal moves */
kmove(Delx,Dely),
Xnew is X + Delx,
Xnew > 0, Xnew =< Size,
Ynew is Y + Dely,
Ynew > 0, Ynew =< Size,
not(claimed(Xnew,Ynew)),
nmoves(Xnew,Ynew,Size,Num),
asserta(move(Xnew,Ynew,Num)),
fail. /* force to next line */
moves(_,_,_,L) :- movelist(L),!.
movelist(L) :- /* accumulate & sort "move" facts */
not(move(_,_,_)),!,L = [].
movelist(L) :-
retract(move(X,Y,Num)),
movelist(L1),
goesin(X,Y,Num,L1,L).
goesin(X,Y,Num,[],[X,Y,Num]). /* insertion sort */
goesin(X,Y,Num,[X1,Y1,Num1|T],[X,Y,Num,X1,Y1,Num1|T]) :-
Num < Num1.
goesin(X,Y,Num,[X1,Y1,Num1|T1],[X1,Y1,Num1|T]) :-
goesin(X,Y,Num,T1,T).
exelist(Movenum,[X,Y,_|T]) :- /* "execute" move list */
empty(X,Y),
claim(Movenum,X,Y).
exelist(Movenum,[_,_,_|T]) :- /* drop 1st move off on backtrack */
exelist(Movenum,T).
nmoves(X,Y,Size,Number) :- /* number of moves from (X,Y) */
kmove(Delx,Dely),
Xnew is X + Delx,
Xnew > 0, Xnew =< Size,
Ynew is Y + Dely,
Ynew > 0, Ynew =< Size,
not(claimed(Xnew,Ynew)),
asserta(count),
fail. /* force to next line */
nmoves(_,_,_,Number) :- sum(0,Number),!.
sum(Sofar,Total) :- /* accumulate "count" facts */
retract(count),
Acc is Sofar + 1,
sum(Acc,Total).
sum(Total,Total). /* recursion bottoms out here */
empty(X,Y) :- claimed(X,Y),!,fail. /* empty fails if square claimed */
empty(X,Y). /* succeeds otherwise */
empty(X,Y) :-
unclaim(X,Y), /* "empties" square on backtrack */
!,fail. /* before failing */
claim(Number,X,Y) :- /* claim a square on board */
asserta(claimed(X,Y)),
Scr_col is 2 + 3 * X,
Scr_row is 1 + 2 * Y,
curset(Scr_row,Scr_col,0),
print(Number).
unclaim(X,Y) :- /* unclaim a square on board */
retract(claimed(X,Y)),
Scr_col is 2 + 3 * X,
Scr_row is 1 + 2 * Y,
curset(Scr_row,Scr_col,0),
print(' ').
/* 1 */ kmove( 1, -2). /* 8 possible knight's moves */
/* 2 */ kmove( 2, -1).
/* 3 */ kmove( 2, 1).
/* 4 */ kmove( 1, 2).
/* 5 */ kmove( -1, 2).
/* 6 */ kmove( -2, 1).
/* 7 */ kmove( -2, -1).
/* 8 */ kmove( -1, -2).
horizlines(X1,X2,Y) :- /* draws horiz grid lines */
drawline(X1,Y,X2,Y,1),
Ynew is Y - 16,
Ynew >= 20,
horizlines(X1,X2,Ynew).
horizlines(_,_,_). /* recursion bottoms out here */
vertlines(Y1,Y2,X) :- /* draws vert grid lines */
drawline(X,Y1,X,Y2,1),
Xnew is X - 24,
Xnew >= 36,
vertlines(Y1,Y2,Xnew).
vertlines(_,_,_). /* recursion bottoms out here */
board(Size) :- /* oversees grid (board) drawing */
integer(Size), Size > 0, Size < 10,
cls, crtset(5),
X1 is 36,
X2 is 36 + 24 * Size,
Y1 is 20,
Y2 is 20 + 16 * Size,
horizlines(X1,X2,Y2),
vertlines(Y1,Y2,X2).
reset :- retract(claimed(_,_)),fail. /* predicate to clean out */
reset :- retract(move(_,_,_)),fail. /* database. Also useful if */
reset. /* program is interrupted. */